home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / m / tanh.c < prev    next >
Text File  |  1988-07-11  |  3KB  |  84 lines
  1. /*
  2.  * Copyright (c) 1985 Regents of the University of California.
  3.  * All rights reserved.
  4.  *
  5.  * Redistribution and use in source and binary forms are permitted
  6.  * provided that this notice is preserved and that due credit is given
  7.  * to the University of California at Berkeley. The name of the University
  8.  * may not be used to endorse or promote products derived from this
  9.  * software without specific prior written permission. This software
  10.  * is provided ``as is'' without express or implied warranty.
  11.  *
  12.  * All recipients should regard themselves as participants in an ongoing
  13.  * research project and hence should feel obligated to report their
  14.  * experiences (good or bad) with these elementary function codes, using
  15.  * the sendbug(8) program, to the authors.
  16.  */
  17.  
  18. #ifndef lint
  19. static char sccsid[] = "@(#)tanh.c    5.2 (Berkeley) 4/29/88";
  20. #endif /* not lint */
  21.  
  22. /* TANH(X)
  23.  * RETURN THE HYPERBOLIC TANGENT OF X
  24.  * DOUBLE PRECISION (VAX D FORMAT 56 BITS, IEEE DOUBLE 53 BITS)
  25.  * CODED IN C BY K.C. NG, 1/8/85; 
  26.  * REVISED BY K.C. NG on 2/8/85, 2/11/85, 3/7/85, 3/24/85.
  27.  *
  28.  * Required system supported functions :
  29.  *    copysign(x,y)
  30.  *    finite(x)
  31.  *
  32.  * Required kernel function:
  33.  *    expm1(x)    ...exp(x)-1
  34.  *
  35.  * Method :
  36.  *    1. reduce x to non-negative by tanh(-x) = - tanh(x).
  37.  *    2.
  38.  *        0      <  x <=  1.e-10 :  tanh(x) := x
  39.  *                              -expm1(-2x)
  40.  *        1.e-10 <  x <=  1      :  tanh(x) := --------------
  41.  *                             expm1(-2x) + 2
  42.  *                              2
  43.  *        1      <= x <=  22.0   :  tanh(x) := 1 -  ---------------
  44.  *                              expm1(2x) + 2
  45.  *        22.0   <  x <= INF     :  tanh(x) := 1.
  46.  *
  47.  *    Note: 22 was chosen so that fl(1.0+2/(expm1(2*22)+2)) == 1.
  48.  *
  49.  * Special cases:
  50.  *    tanh(NaN) is NaN;
  51.  *    only tanh(0)=0 is exact for finite argument.
  52.  *
  53.  * Accuracy:
  54.  *    tanh(x) returns the exact hyperbolic tangent of x nealy rounded.
  55.  *    In a test run with 1,024,000 random arguments on a VAX, the maximum
  56.  *    observed error was 2.22 ulps (units in the last place).
  57.  */
  58.  
  59. double tanh(x)
  60. double x;
  61. {
  62.     static double one=1.0, two=2.0, small = 1.0e-10, big = 1.0e10;
  63.     double expm1(), t, copysign(), sign;
  64.     int finite();
  65.  
  66. #if !defined(vax)&&!defined(tahoe)
  67.     if(x!=x) return(x);    /* x is NaN */
  68. #endif    /* !defined(vax)&&!defined(tahoe) */
  69.  
  70.     sign=copysign(one,x);
  71.     x=copysign(x,one);
  72.     if(x < 22.0) 
  73.         if( x > one )
  74.         return(copysign(one-two/(expm1(x+x)+two),sign));
  75.         else if ( x > small )
  76.         {t= -expm1(-(x+x)); return(copysign(t/(two-t),sign));}
  77.         else        /* raise the INEXACT flag for non-zero x */
  78.         {big+x; return(copysign(x,sign));}
  79.     else if(finite(x))
  80.         return (sign+1.0E-37); /* raise the INEXACT flag */
  81.     else
  82.         return(sign);    /* x is +- INF */
  83. }
  84.